
;compiler and make-vista

(setf *devel-version* t)

;;code for make-vista, and compile functions


(defun load-distributor () (distrib-mode))
(defun distrib-mode ()
  (when (load (strcat *default-path* "source\\distrib\\distributor.lsp")
              :if-does-not-exist nil)
        (add-distribution-item)
        (unless *devel-mode* (devel-mode))
        (defun distrib-mode ())
        ))

(defun refresh-vista ()
  (set-current-directory *default-path*)
  (save-all-prefs)
  (system "vista.exe")
  (exit))


(defun restart-vista (&optional dir)
  (compile-changed-vista-sources)
  (write-prefload-file)
  (double-dribble)
  (save-all-prefs)
  (if dir
      (system (strcat dir "vista.exe"))
      (system (strcat *default-path* "vista.exe")))
  (exit))

(defun post-compile-options ()
  (let* ((dialog))
    (setf dialog
          (choice-item-dialog 
           (format nil "COMPILATION FINISHED.~%Make a Choice:")
           '("(remake-workspace)"
             "(restart-vista)"
             "(show-vista)"
             "(exit)"
              )
           (list 
            '(progn (remake-workspace) (remove-me))
            '(progn (restart-vista) (remove-me))
            '(progn (show-vista) (remove-me))
            '(exit)
            )
           :title "Debug Options"))
    (defun remove-me () (send dialog :remove))))

(defun compile-vista-base-file-dialog ()
  (nodebug)
  (let ((filename (get-string-dialog "Enter ViSta Base File Name")))
    (when filename (compile-vista-base-file filename))))

(defun compile-exit ()
  (make-vista :exit t))

(defun compile-exit ()
  (vista-exit t t))

(defun make-vista (&key exit)
  (set-working-directory *lib-path*)
  (unless (probe-file "maketime\\fastload.lsp")
          (make-default-ini))
  (when (and (boundp '*vista*) *vista*) (hide-vista)(listeners :micro t))
  (setf *please-wait* 
        (please-wait 
         "Compile ViSta: Searching for Changed Files" :pause 30
         :title "Compile ViSta"))
  (defmeth dialog-proto :do-click (x y m1 m2)
    (listeners)
    (send self :close))
  
 ; (set-working-directory *xlib-path*)
  (load "maketime\\fastload")
  (compile-changed-vista-sources)
  (cond
    (*rebuild-after-compile-needed*
     (please-wait "Compile ViSta: Preparing to ReBuild WorkSpace" :pause 30
                  :title "Compile ViSta")
     (setf *rebuild-after-compile-needed* nil)
     (remake-workspace))
    (*compiled-any-files?* 
     ;(send *please-wait* :remove)
     (post-compile-options))
    (t
     (exit)))
  )
  
(defun system-timer ()
  (setf *system-timer* (send graph-window-proto :new :show nil)) 
  (defmeth *system-timer* :do-idle ()
    (when *please-wait* (send *please-wait* :close)) 
    (listeners)
    (defmeth self :do-idle ())
    (send self :idle-on nil)))


(setf *file-being-compiled* nil)

(defun remake-vista ()
  (cond
    (*file-being-compiled*
     (compile-vista-file *file-being-compiled*) 
     (keep-going))
    (t  (make-vista))))
  

(defun get-compiler-system ()
  (setf *compiler-verbose* t)
  (setf *load-verbose* t)
  (setf *file-verbose* t)
  ;(hidemainwindow)
  ;(maxmainwindow)
  ;(listeners)
  (setf *please-wait* 
        (please-wait (format nil "Compile ViSta: Loading Compiler") :pause 30
                    :title "Compile ViSta"))
  (defmeth *please-wait* :close ()
            (send self :remove)
            (listeners)
            (setf *please-wait* nil))
  (unless (load (strcat *default-path* "autoload\\cmpload.fsl") 
                :if-does-not-exist nil)
          (message-dialog 
           (format nil "Please use next dialog to locate~%AUTOLOAD\\CMPLOAD.FSL"))
          (load (open-file-dialog)))
  (show-compile-msg)
  (setf *compiler-loaded* t)
  (setf *compiling* t)
  (setf *compiled-any-files?* t)
  (setf *compile-date* (time-stamp))
  (setf *compile-id* (user-id))
  (format t "~%;*compile-id* ~a" *compile-id*)
  t)

(defun compile-vista-file (file)
"Function Args: FILE
Compiles FILE in directory *source-dir-name*. FILE does not need an extension (.lsp is stripped off)."

  ;(one-button-dialog "compile-vista-file")
  (when (equal "psl." (select (reverse file) (iseq 4)))
        (setf file (select file (iseq (- (length file) 4)))))
  
  (setf *file-being-compiled* (strcat *source-dir-name* file ".lsp"))
  (please-wait (format nil "Compile ViSta: Compiling vista-file/~a.lsp" file) 
                 :pause 30 :title "Compile ViSta")
  (compile-file (strcat *source-dir-name* file ".lsp")
                :output-file (strcat *fsl-dir-name* file ".fsl")
                :print t :verbose t))

(defun compile-vista-files (list)
    (mapcar #'compile-vista-file list))

(defun compile-vista-base ()
  (time
   (mapcar #'compile-vista-base-file *base-files*)
   (format t "Base File Compilation Finished Successfully."))
   )

(defun compile-vista-base-file (file)
"Function Args: FILE
Compiles FILE in directory *source-dir-name*. FILE may have an extension. Places compiled result in *fsl-dir-name*"
  #-x11 (show-listener)
(one-button-dialog "compile-vista-base-file")
  (when (equal "psl." (select (reverse file) (iseq 4)))
        (setf file (select file (iseq (- (length file) 4)))))
  (setf *file-being-compiled* (strcat *source-dir-name* file ".lsp"))
  (please-wait (format nil "Compile ViSta: Compiling base/~a.lsp" file) 
                 :pause 30 :title "Compile ViSta")
  (compile-file (strcat *source-dir-name* file ".lsp")
                :output-file (strcat *fsl-dir-name* file ".fsl")
                :print t :verbose t)
  (format t "; writing fsl file ~a~%~%"(strcat *fsl-dir-name* file ".fsl")) 
  )


(defun compile-vista-source-file (file-list)
"Function Args: FILE-LIST 
FILE-LIST must be a list of 3 strings that are the directory, name and extension of the file being compiled. Compiles file named by second string and ignores other strings, assuming file is in directory *SOURCE-DIR-NAME* with extension .lsp. Places compiled result in *fsl-dir-name*."
(one-button-dialog "compile-vista-source-file")
  (unless *compiler-loaded* (get-compiler-system))
  (let* ((file (second file-list))
         (dir (if *source-dir-name* *source-dir-name*
                  (strcat (get-working-directory) separator "source" separator)))
         (outdir (if *fsl-dir-name* *fsl-dir-name*
                     (strcat (get-working-directory) separator "fslfiles" separator)))
         )
    (please-wait (format nil "Compile ViSta: Compiling source/~a.lsp" file) 
                 :pause 30 :title "Compile ViSta")
   ; (unless *compile-msg-flag* (show-compilation))
    (setf *file-being-compiled* (strcat dir file ".lsp"))
    (cond
      ((ignore-errors (compile-file (strcat dir file ".lsp")
                                    :output-file (strcat outdir file ".fsl"))
                      t)
       (format t "; compiled and saved fsl file ~a~%~%"(strcat outdir file ".fsl")))
      (t
       (compile-err-msg outdir file)
       ))
    ))


      

;replaced by following function by fwy 20010329

(defun compile-vista-source-file (file-list)
"Function Args: FILE-LIST 
FILE-LIST must be a list of 3 strings that are the directory, name and extension of the file being compiled. Compiles file named by second string and ignores other strings, assuming file is in directory *SOURCE-DIR-NAME* with extension .lsp. Places compiled result in *fsl-dir-name*."
  (unless *compiler-loaded* (get-compiler-system))
  (let* ((file (second file-list))
         (dir (if *source-dir-name* *source-dir-name*
                  (strcat (get-working-directory) separator "source" separator)))
         (outdir (if *fsl-dir-name* *fsl-dir-name*
                     (strcat (get-working-directory) separator "fslfiles" separator)))
         )
    (setf *file-being-compiled* (strcat dir file ".lsp"))
    (please-wait (format nil "Compile ViSta: Compiling ~a.lsp" file) 
                 :title "Compile ViSta" :pause 30)
    (unless *compile-msg-flag* (show-compilation))
    (compile-file (strcat dir file ".lsp") :output-file (strcat outdir file ".fsl"))
   ; (format t "; compiled  ~a~%"(strcat dir file ".lsp"))
    (format t "; saved     ~a~%~%"(strcat outdir file ".fsl"))
    ))

(defun compile-vista-make-file (file)
  (compile-any-vista-file (strcat *default-path* "maketime\\") file "Make   "))

(defun compile-vista-runtime-file (file)
  (compile-any-vista-file *runtime-dir-name* file "RunTime"))

(defun compile-any-vista-file (dir file file-loc)
"Function Args: DIR FILE FILE-LOC
DIR must be a string of the directory FILE is in. FILE must be a string of the name and extension of the file being compiled. FILE-LOC is a string of the location. If DIR\FILE.LSP is newer than DIR\FILE.FSL, compiles FILE, assuming file is in directory DIR, placing compiled result in DIR."
  (let* ((outdir dir)
         (fsl-file (strcat dir file ".fsl"))
         (fsl-file-date)
         )
    (if (probe-file fsl-file) 
        (setf fsl-file-date (file-write-date fsl-file))
        (setf fsl-file-date 0))
    (when (> (file-write-date (strcat dir file ".lsp")) fsl-file-date)
          (unless *compile-msg-flag* (show-compilation))
          (unless *compiler-loaded* (get-compiler-system))
          (please-wait 
           (format nil "Compile ViSta: Compiling ~a.lsp" file)
           :title "Compile ViSta"
           :pause 30)
          
          (setf *file-being-compiled* (strcat dir file ".lsp"))
          (cond
            ((ignore-errors (compile-file (strcat dir file ".lsp")
                                          :output-file (strcat outdir file ".fsl")
                                          :print t :verbose t)
                            t)
             (please-wait (format nil "Compile ViSta: - Searching ~a Files " file-loc)
                          :title "Compile ViSta")
             (format t "; compiled and saved fsl file ~a~%~%"(strcat outdir file ".fsl")))
            (t
             (compile-err-msg outdir file)
             )))))
  
    
(defun compile-err-msg (outdir file)
 ; (send *please-wait* :remove)
  (listeners)
  (please-wait (format nil "Cannot compile ~a. Error after last function listed. If at end of file, kill copies of ViSta running invisibly. " (string-upcase (strcat file ".lsp"))))
  (top-level))



(defun initialize-vista-workspace ()
  (let ((separator
         #+macintosh ":"
         #+msdos "\\"
         #+X11 "/"
         ))
    (setf *vista-dir-name* (strcat (get-working-directory) "ViSta" separator))
    (setf *help-dir-name*  (strcat *vista-dir-name* "Help" separator))
    (setf *guide-dir-name* (strcat *vista-dir-name* "Guidance" separator)))
  (menus)
  (show-workmap)
  (move-listener))


